#Clear Workspace----
rm(list = ls())
#Data Cleaning—-
#Import data----
PHQ <- read.csv("~/Desktop/[Group1_TheodoreWiebold]MCA-PHQ/PHQdata.csv", header = TRUE, sep = "", quote="\"", row.names = NULL)
#header = TRUE makes first row the header
#sep = "", quote = "\"" will maintain the variabels and columns and remove the " "
rawobservations <- nrow(PHQ) #shows number of observations from raw dataset
#Remove rows with missing data----
PHQ <- na.omit(PHQ) #omits rows with no values
naomitobservations <- nrow(PHQ) #shows number of observations from naomit data
naomit <- rawobservations - naomitobservations #shows number of observations removed
#Remove duplicates after the first attempt----
n_occurWithDuplicates <- data.frame(table(PHQ$row.names)) #gives a dataframe of how many times each id occured in the data
NumberOfDubplicates <- sum(n_occurWithDuplicates$Freq-1) #gives the number of duplicates, if more 0 remove # from beginning of loop
#for (i in 1:NumberOfDubplicates) { #for-loop removing duplicates
#y <- anyDuplicated(PHQ$row.names)
#PHQ <- PHQ[-y,]
# }
n_occurNoDuplicates <- data.frame(table(PHQ$row.names)) #shows there are no duplicates reamining
#Remove columns and rows with string identifiers----
#PHQ <- PHQ[,-1] #removes first column of id numbers
GroupingVaribles <- PHQ[,c(2,3,4,5)] #creates a grouping variable matrix
PHQ <- PHQ[,c(-1, -2, -3, -4, -5)] #removes columns of grouping variables
totalscore <- rowSums(PHQ)
#Creat grouping based on Depression Severity----
for (i in 1:length(totalscore)){
severity <- totalscore[i]
if (severity <= 18){
totalscore[i] <- 1 #minimal symptoms
}
if (severity > 18 & severity <= 23){
totalscore[i] <- 2 #major depression, mild
}
if (severity > 23 & severity <= 28){
totalscore[i] <- 3 #major depression, moderately severe
}
if (severity >28){
totalscore[i] <- 4 #major depression, severe
}
}
SeverityLabel <- c("Minimal Symptoms", "Mild", "Moderately Severe", "Severe")
#Make key words as each variable representing each question in PHQ9----
colnames(PHQ) <- c('Pleasure','Hopeless','Sleep','Energy','Appetite','Failure','Focus','Speed','Suicide')
#Convert character to numeric in all columns----
PHQ[ , c(1:ncol(PHQ))] <- apply(PHQ[ , c(1:ncol(PHQ))], 2, function(x) as.numeric(as.character(x)))
#Convert to MCA
library(TExPosition)
# Have a look and create empty SamplesMatrix and MCAdata
Question <- colnames(PHQ)[1:9]
BinMatrix <- matrix(, nrow = 9, ncol = 4)
row.names(BinMatrix) <- Question
colnames(BinMatrix) <- c("Bin 1 (1)", "Bin 2 (2)", "Bin 3 (3/4)", "Spearman")
MCAdata <- matrix(, nrow = 225, ncol = 9)
colnames(MCAdata) <- Question
row.names(MCAdata) <- c(1:225)
##Create BinMatrix and MCAdata
for (i in 1:9) {
if (i <= 8){
recode <- cut(PHQ[,i],breaks = c(min(PHQ[,1]),1.5,2,max(PHQ[,i])+1),include.lowest = T)
#Fills MCAdata
MCAdata[,i] <- recode
#Fills BinMatrix (binned according to PHQ tool)
populate <- data.frame(table(recode))
populate <- t(populate$Freq)
BinMatrix[i,1:3] <- populate
BinMatrix[i,4] <- cor(PHQ[,i],as.numeric(recode), method = "spearman")
#Creates histograms with bin lines
Distribution <-hist(PHQ[,i], breaks = 8, col = c(rgb(48, 90, 191, 125, maxColorValue=255), rgb(132, 191, 48, 125, maxColorValue=255), NA, rgb(191, 48, 173, 125, maxColorValue=255), NA, rgb(191, 48, 173, 125, maxColorValue=255)), main = paste("Histogram of", colnames(PHQ)[i]), xlab = "Question Answer")
Distribution <- abline(v = c(1.5,2), col = "red")
Distribution <- legend("topright", legend = c(c(colnames(BinMatrix)[1],BinMatrix[i,1]), c(colnames(BinMatrix)[2],BinMatrix[i,2]), c(colnames(BinMatrix)[3], BinMatrix[i,3]), c(colnames(BinMatrix)[4], round(BinMatrix[i,4], digits = 4))),pch = 16, pt.cex = 2, cex = .75, bty = 'n', col =c(rgb(48, 90, 191, 125, maxColorValue=255), NA, rgb(132, 191, 48, 125, maxColorValue=255), NA, rgb(191, 48, 173, 125, maxColorValue=255), NA, NA, NA))
} else {
recode <- cut(PHQ[,i],breaks = c(min(PHQ[,1]),1.5,max(PHQ[,i])+1),include.lowest = T)
#Fills MCAdata
MCAdata[,i] <- recode
#Fills BinMatrix (Binned according to PHQ tool)
populate <- data.frame(table(recode))
populate <- t(populate$Freq)
BinMatrix[i,1:2] <- populate
BinMatrix[i,3] <- NA
BinMatrix[i,4] <- cor(PHQ[,i],as.numeric(recode), method = "spearman")
#Creates histogram with bin line and legend
Distribution <-hist(PHQ[,i], breaks = 8, col = c(rgb(48, 90, 191, 125, maxColorValue=255), c(rgb(191, 48, 173, 125, maxColorValue=255), rgb(191, 48, 173, 125, maxColorValue=255), rgb(191, 48, 173, 125, maxColorValue=255))), main = paste("Histogram of", colnames(PHQ)[i]), xlab = "Question Answer")
Distribution <- legend("topright", legend = c(c(colnames(BinMatrix)[1],BinMatrix[i,1]), c(colnames(BinMatrix)[2],BinMatrix[i,2]), c(colnames(BinMatrix)[4], round(BinMatrix[i,4], digits = 4))),pch = 16, pt.cex = 2, cex = .75, bty = 'n', col =c(rgb(48, 90, 191, 125, maxColorValue=255), NA, rgb(191, 48, 173, 125, maxColorValue=255), NA, NA, NA))
Distribution <- abline(v = 1.5, col = "red")
}
}
#BinMatrix
## Look at the variables ----
#hist.Pleasure <- hist(PHQ[,1], breaks = 20, main = paste("Histogram of", colnames(PHQ)[1]))
#Pleasure_recode <- cut(PHQ[,1],breaks = c(min(PHQ[,1]),1.5,2,max(PHQ[,1])+1),include.lowest = T)
#Pleasure <- data.frame(table(Pleasure_recode))
#Pleasure <- t(Pleasure$Freq)
# check the spearman's rank correlation
#PleasureCor <- cor(PHQ[,1],as.numeric(Pleasure_recode), method = "spearman")
#hist.Hopeless <- hist(PHQ[,2], breaks = 20, main = paste("Histogram of", colnames(PHQ)[2]))
#Hopeless_recode <- cut(PHQ[,2],breaks = c(min(PHQ[,2]),1.5,2,max(PHQ[,2])+1),include.lowest = T)
#table(Hopeless_recode)
# check the spearman's rank correlation
#cor(PHQ[,2],as.numeric(Hopeless_recode), method = "spearman")
#hist.Sleep <- hist(PHQ[,3], breaks = 20, main = paste("Histogram of", colnames(PHQ)[3]))
#Sleep_recode <- cut(PHQ[,1],breaks = c(min(PHQ[,1]),1.5,2,max(PHQ[,1])+1),include.lowest = T)
#table(Pleasure_recode)
# check the spearman's rank correlation
#cor(PHQ[,1],as.numeric(Pleasure_recode), method = "spearman")
#hist.Energy <- hist(PHQ[,4], breaks = 20, main = paste("Histogram of", colnames(PHQ)[4]))
#hist.Appetite <- hist(PHQ[,5], breaks = 20, main = paste("Histogram of", colnames(PHQ)[5]))
#hist.Failure <- hist(PHQ[,6], breaks = 20, main = paste("Histogram of", colnames(PHQ)[6]))
#hist.Focus <- hist(PHQ[,7], breaks = 20, main = paste("Histogram of", colnames(PHQ)[7]))
#hist.Speed <- hist(PHQ[,8], breaks = 20, main = paste("Histogram of", colnames(PHQ)[8]))
#hist.Suicide <- hist(PHQ[,9], breaks = 20, main = paste("Histogram of", colnames(PHQ)[9]))
#Suicide_recode <- cut(PHQ[,9],breaks = c(min(PHQ[,9]),1.5,max(PHQ[,9])+1),include.lowest = T)
#Suicide <- data.frame(table(Suicide_recode))
#Suicide <- t(Suicide$Freq)
# check the spearman's rank correlation
#SuicideCor <- cor(PHQ[,9],as.numeric(Suicide_recode), method = "spearman")
#hist.Pleasure
#hist.Hopeless
#hist.Sleep
#hist.Energy
#hist.Appetite
#hist.Failure
#hist.Focus
#hist.Speed
#hist.Suicide
It measures the 9 different beers (rows) on 30 beer characteristics (columns).
head(MCAdata, n = 6L)
## Pleasure Hopeless Sleep Energy Appetite Failure Focus Speed Suicide
## 1 1 1 2 3 1 1 1 1 1
## 2 1 1 1 2 1 1 1 1 1
## 3 1 1 1 1 1 1 1 1 1
## 4 1 3 3 2 3 2 1 1 1
## 5 1 1 1 1 1 1 1 1 1
## 6 1 2 3 3 1 3 2 1 1
#Heatmap of Loadings
#MCA heat map
corrMatBurt.list <- phi2Mat4BurtTable(MCAdata)
cor.plot.numPhi22 <- corrplot(as.matrix(corrMatBurt.list$phi2.mat), method = "number", type = "upper", tl.pos = "lt", tl.cex = .7, tl.srt = 45, addCoefasPercent = TRUE, number.cex = .7)
cor.plot.fullPhi22 <- corrplot(as.matrix(corrMatBurt.list$phi2.mat), method = "ellipse", type = "lower", add = TRUE,
diag = FALSE, tl.pos = "n", cl.pos = "n")
a0001a.corMat.phi2 <- recordPlot()
# We need correlation to compare with PCA
corrMatBurt.list <- phi2Mat4BurtTable(MCAdata)
cor.plot.numPhi2 <- corrplot(as.matrix(sqrt(corrMatBurt.list$phi2.mat)), method = "number", type = "upper", tl.pos = "lt", tl.cex = .7, tl.srt = 45, addCoefasPercent = TRUE, number.cex = .7)
cor.plot.fullPhi2 <- corrplot(as.matrix(sqrt(corrMatBurt.list$phi2.mat)), method = "ellipse", type = "lower", add = TRUE,
diag = FALSE, tl.pos = "n", cl.pos = "n")
a0001b.corMat.phi <- recordPlot()
#PHQ data Factor Table
cov.plot.PHQ <-cov(PHQ)
diag(cov.plot.PHQ) <- 1
cov.plot.numPHQ <- corrplot(cov.plot.PHQ, method = "number", type = "upper", tl.pos = "lt",
tl.cex = .7, tl.srt = 45, addCoefasPercent = TRUE, number.cex = .7)
cov.plot.fullPHQ <- corrplot(cov.plot.PHQ, method = "ellipse", type = "lower", add = TRUE,
diag = FALSE, tl.pos = "n", cl.pos = "n")
#MCAdata Factor Table
cov.plot.MCAdata <-cov(MCAdata)
diag(cov.plot.MCAdata) <- 1
cov.plot.MCAdata <- corrplot(cov.plot.MCAdata, method = "number", type = "upper", tl.pos = "lt",
tl.cex = .7, tl.srt = 45, addCoefasPercent = TRUE, number.cex = .7)
cov.plot.fullMCAdata <- corrplot(cov.plot.MCAdata, method = "ellipse", type = "lower", add = TRUE,
diag = FALSE, tl.pos = "n", cl.pos = "n")
#Correlate MCAdata and PHQ
cor.plot.dataBoth <-cor(PHQ, MCAdata, method = "spearman")
#diag(cov.plot.dataPHQ9) <- 1
cor.plot.numBoth <- corrplot(cor.plot.dataBoth, method = "number", type = "full", tl.pos = "lt", number.cex = 1, tl.cex = .9, tl.srt = 45, addCoefasPercent = TRUE)
resPCA <- epPCA(MCAdata,
scale = FALSE, # Make to use 'SS1' rather than TRUE
DESIGN = totalscore,
graphs = FALSE)
MCAdata <- makeNominalData(MCAdata)
resMCA <- epMCA(MCAdata,
make_data_nominal = FALSE,
DESIGN = totalscore,
graphs = FALSE)
ColorTheme <- prettyGraphsColorSelection(n.colors = 9)
# contributions for variables
ctrK <- ctr4Variables(resMCA$ExPosition.Data$cj)
for (j in 1:ncol(ctrK)) {
ctrK1 <- ctrK[,j]
names(ctrK1) <- rownames(ctrK)
a0005.Var.ctr1 <- PrettyBarPlot2(ctrK1,
main = paste("Variable Contributions: ", colnames(ctrK)[j]), ylim = c(-.05, 1.2*max(ctrK1)),
font.size = 5,
threshold = 1 / nrow(ctrK),
color4bar = gplots::col2hex(ColorTheme)
)
print(a0005.Var.ctr1)
}
## Inference
resMCA.inf <- InPosition::epMCA.inference.battery(MCAdata,
make_data_nominal = FALSE,
DESIGN = totalscore,
graphs = FALSE) # TRUE first pass only
## [1] "It is estimated that your iterations will take 0.02 minutes."
## [1] "R is not in interactive() mode. Resample-based tests will be conducted. Please take note of the progress bar."
## ===========================================================================
#Scree Plot
scree.mca <- PlotScree(ev = resMCA$ExPosition.Data$eigs,
p.ev = resMCA.inf$Inference.Data$components$p.vals,
plotKaiser = TRUE,
title = "MCA Explained Variance per Dimension")
#Permutation Tests for Significant Eigenvalues
zeDim = 1
pH1 <- prettyHist(
distribution = resMCA.inf$Inference.Data$components$eigs.perm[,zeDim],
observed = resMCA.inf$Fixed.Data$ExPosition.Data$eigs[zeDim],
xlim = c(.001, .25), # needs to be set by hand
breaks = 20,
border = "white",
main = paste0("Permutation Test for Eigenvalue ",zeDim),
xlab = paste0("Eigenvalue ",zeDim),
ylab = "",
counts = FALSE,
cutoffs = c( 0.975))
eigs1 <- recordPlot()
zeDim = 2
pH2 <- pH1 <- prettyHist(
distribution = resMCA.inf$Inference.Data$components$eigs.perm[,zeDim],
observed = resMCA.inf$Fixed.Data$ExPosition.Data$eigs[zeDim],
xlim = c(.001, .0325), # needs to be set by hand
breaks = 20,
border = "white",
main = paste0("Permutation Test for Eigenvalue ",zeDim),
xlab = paste0("Eigenvalue ",zeDim),
ylab = "",
counts = FALSE,
cutoffs = c(0.975))
eigs2 <- recordPlot()
zeDim = 3
pH1 <- prettyHist(
distribution = resMCA.inf$Inference.Data$components$eigs.perm[,zeDim],
observed = resMCA.inf$Fixed.Data$ExPosition.Data$eigs[zeDim],
xlim = c(.001, .0065), # needs to be set by hand
breaks = 20,
border = "white",
main = paste0("Permutation Test for Eigenvalue ",zeDim),
xlab = paste0("Eigenvalue ",zeDim),
ylab = "",
counts = FALSE,
cutoffs = c( 0.975))
eigs1 <- recordPlot()
#Legend
#Makes the legend for graph----
Legend <- plot(NULL, xaxt = 'n', yaxt = 'n', bty = 'n', ylab = '', xlab = '', xlim = 0:1, ylim = 0:1)
Legend <- legend("topleft", legend = c("Minimal Symptoms", "Mild", "Moderately Severe", "Severe"),pch = 16, pt.cex = 2, cex = .75, bty = 'n', col =c(rgb(48, 90, 191, 125, maxColorValue=255), rgb(191, 48, 173, 125, maxColorValue=255), rgb(132, 191, 48, 125, maxColorValue=255), rgb(48, 191, 167, 125, maxColorValue=255)))
Lengend <- mtext("Major Depression Severity", at = 0.1, cex = 1.5)
#Dimension 1 and 2
axis1 <- 1
axis2 <- 2
# generate the set of maps
BaseMap.Fi <- createFactorMap(resMCA$ExPosition.Data$fi,
axis1 = axis1, axis2 = axis2,
title = 'MCA Row Factor Scores Dimension 1 and 2',
col.points = resMCA.inf$Fixed.Data$Plotting.Data$fi.col, cex = 1,
col.labels = resMCA.inf$Fixed.Data$Plotting.Data$fi.col, text.cex = 0,
force = 2)
# add labels
labels4MCA <- createxyLabels.gen(x_axis = axis1, y_axis = axis2, lambda = resMCA$ExPosition.Data$eigs, tau = resMCA$ExPosition.Data$t)
# make the maps
b0002.BaseMap.Fi <- BaseMap.Fi$zeMap + labels4MCA
b0002.BaseMap.Fi
#Means for severity groups
group.mean <- aggregate(resMCA.inf$Fixed.Data$ExPosition.Data$fi,
by = list(totalscore), # must be a list
mean)
# need to format the results from `aggregate` correctly
rownames(group.mean) <- group.mean[,1] # Use the first column as row names
fi.mean <- group.mean[,-1] # Exclude the first column
# get index for the first row of each group
grp.ind <- order(totalscore)[!duplicated(sort(totalscore))]
grp.col <- resMCA.inf$Fixed.Data$Plotting.Data$fi.col[grp.ind] # get the color
grp.name <- totalscore[grp.ind] # get the corresponding groups
names(grp.col) <- grp.name
fi.mean.plot <- createFactorMap(fi.mean[,c(1,2)],
alpha.points = 0.8,
col.points = grp.col[rownames(fi.mean)],
col.labels = grp.col[rownames(fi.mean)],
pch = 17,
cex = 3,
text.cex = 3)
fi.WithMean <- BaseMap.Fi$zeMap_background + BaseMap.Fi$zeMap_dots + fi.mean.plot$zeMap_dots + fi.mean.plot$zeMap_text + labels4MCA
fi.WithMean
# Bootstrap the Means
fi.boot <- Boot4Mean(resMCA.inf$Fixed.Data$ExPosition.Data$fi,
design = totalscore,
niter = 1000)
# Bootstrap Plot of Dimension 1 and 2
bootCI4mean <- MakeCIEllipses(fi.boot$BootCube[,c(1:2),], # get the first two components
col = grp.col[rownames(fi.mean)])
fi.WithMeanCI <- BaseMap.Fi$zeMap_background + bootCI4mean + BaseMap.Fi$zeMap_dots + fi.mean.plot$zeMap_dots + fi.mean.plot$zeMap_text + labels4MCA
fi.WithMeanCI
######################################################################################################
#Dimension 2 and 3
axis1 = 2
axis2 = 3
# generate the set of maps
BaseMap.Fi2 <- createFactorMap(resMCA$ExPosition.Data$fi,
axis1 = axis1, axis2 = axis2,
title = 'MCA Row Factor Scores Dimensions 2 and 3',
col.points = resMCA.inf$Fixed.Data$Plotting.Data$fi.col, cex = 1,
col.labels = resMCA.inf$Fixed.Data$Plotting.Data$fi.col, text.cex = 0,
force = 2)
# add labels
labels4MCA2 <- createxyLabels.gen(x_axis = axis1, y_axis = axis2, lambda = resMCA$ExPosition.Data$eigs, tau = resMCA$ExPosition.Data$t)
# make the maps
b0003.BaseMap.Fi2 <- BaseMap.Fi2$zeMap + labels4MCA2
b0003.BaseMap.Fi2
#Means for severity groups
group.mean <- aggregate(resMCA.inf$Fixed.Data$ExPosition.Data$fi,
by = list(totalscore), # must be a list
mean)
# need to format the results from `aggregate` correctly
rownames(group.mean) <- group.mean[,1] # Use the first column as row names
fi.mean <- group.mean[,-1] # Exclude the first column
# get index for the first row of each group
grp.ind <- order(totalscore)[!duplicated(sort(totalscore))]
grp.col <- resMCA.inf$Fixed.Data$Plotting.Data$fi.col[grp.ind] # get the color
grp.name <- totalscore[grp.ind] # get the corresponding groups
names(grp.col) <- grp.name
fi.mean.plot2 <- createFactorMap(fi.mean[,c(2,3)],
alpha.points = 0.8,
col.points = grp.col[rownames(fi.mean)],
col.labels = grp.col[rownames(fi.mean)],
pch = 17,
cex = 3,
text.cex = 3)
fi.WithMean2 <- BaseMap.Fi2$zeMap_background + BaseMap.Fi2$zeMap_dots + fi.mean.plot2$zeMap_dots + fi.mean.plot2$zeMap_text + labels4MCA2
fi.WithMean2
# Bootstrap the Means
fi.boot2 <- Boot4Mean(resMCA.inf$Fixed.Data$ExPosition.Data$fi,
design = totalscore,
niter = 1000)
# Bootstrap Plot of Dimension 1 and 2
bootCI4mean2 <- MakeCIEllipses(fi.boot2$BootCube[,c(2:3),], names.of.factors = paste0('Dimension ',c(2,3)), # get the 2nd and 3rd components
col = grp.col[rownames(fi.mean)])
fi.WithMeanCI2 <- BaseMap.Fi2$zeMap_background + bootCI4mean2 + BaseMap.Fi2$zeMap_dots + fi.mean.plot2$zeMap_dots + fi.mean.plot2$zeMap_text + labels4MCA2
fi.WithMeanCI2
#Colors for Variables (Grouped)
#ColorTheme <- prettyGraphsColorSelection(n.colors = 9)
t <- 1
for (k in 1:8) {
p <- (k + (2*k))
resMCA.inf$Fixed.Data$Plotting.Data$fj.col[t:p,] <- ColorTheme[k]
t <- (t + 3)
}
resMCA.inf$Fixed.Data$Plotting.Data$fj.col[25:26,] <- ColorTheme[9]
#Dimension 1 and 2
axis1 <- 1
axis2 <- 2
# generate the set of maps
BaseMap.Fj <- createFactorMap(resMCA$ExPosition.Data$fj,
axis1 = axis1, axis2 = axis2,
title = 'MCA Column Loadings Dimension 1 and 2',
col.points = resMCA.inf$Fixed.Data$Plotting.Data$fj.col, cex = 1,
col.labels = resMCA.inf$Fixed.Data$Plotting.Data$fj.col, text.cex = 2.5,
force = 2)
# add labels
labels4MCAj <- createxyLabels.gen(x_axis = axis1, y_axis = axis2, lambda = resMCA$ExPosition.Data$eigs, tau = resMCA$ExPosition.Data$t)
# make the maps
A0002.BaseMap.Fj <- BaseMap.Fj$zeMap + labels4MCAj
A0002.BaseMap.Fj
lines4J <- addLines4MCA(resMCA$ExPosition.Data$fj, col4Var = resMCA.inf$Fixed.Data$Plotting.Data$fj.col, size = .7)
A0002.BaseMap.Fj2 <- A0002.BaseMap.Fj + lines4J
A0002.BaseMap.Fj2
#######################################################################################################
#Dimension 3 and 4
axis1 = 2
axis2 = 3
# generate the set of maps
BaseMap.Fj2 <- createFactorMap(resMCA$ExPosition.Data$fj,
axis1 = axis1, axis2 = axis2,
title = 'MCA Column Loadings Dimensions 2 and 3',
col.points = resMCA.inf$Fixed.Data$Plotting.Data$fj.col, cex = 1,
col.labels = resMCA.inf$Fixed.Data$Plotting.Data$fj.col, text.cex = 2.5,
force = 2)
# add labels
labels4MCA2j <- createxyLabels.gen(x_axis = axis1, y_axis = axis2, lambda = resMCA$ExPosition.Data$eigs, tau = resMCA$ExPosition.Data$t)
# make the maps
b0003.BaseMap.Fj2 <- BaseMap.Fj2$zeMap + labels4MCA2j
b0003.BaseMap.Fj2
lines4J <- addLines4MCA(resMCA$ExPosition.Data$fj, col4Var = resMCA.inf$Fixed.Data$Plotting.Data$fj.col, size = .7, axis_h = 2, axis_v = 3)
b0003.BaseMap.Fj2 <- b0003.BaseMap.Fj2 + lines4J
b0003.BaseMap.Fj2
signed.ctrJ <- resMCA$ExPosition.Data$cj * sign(resMCA$ExPosition.Data$fj)
# plot contributions of columns for component 1
ctrJ.1 <- PrettyBarPlot2(signed.ctrJ[,1],
threshold = 1 / NROW(signed.ctrJ),
font.size = 3,
color4bar = gplots::col2hex(resMCA.inf$Fixed.Data$Plotting.Data$fj.col), # we need hex code
ylab = 'Contributions',
ylim = c(1.2*min(signed.ctrJ), 1.2*max(signed.ctrJ))
) + ggtitle("", subtitle = 'columns component 1')
# plot contributions of columns for component 2
ctrJ.2 <- PrettyBarPlot2(signed.ctrJ[,2],
threshold = 1 / NROW(signed.ctrJ),
font.size = 3,
color4bar = gplots::col2hex(resMCA.inf$Fixed.Data$Plotting.Data$fj.col), # we need hex code
ylab = 'Contributions',
ylim = c(1.2*min(signed.ctrJ), 1.2*max(signed.ctrJ))
) + ggtitle("", subtitle = 'columns component 2')
# plot contributions of columns for component 3
ctrJ.3 <- PrettyBarPlot2(signed.ctrJ[,3],
threshold = 1 / NROW(signed.ctrJ),
font.size = 3,
color4bar = gplots::col2hex(resMCA.inf$Fixed.Data$Plotting.Data$fj.col), # we need hex code
ylab = 'Contributions',
ylim = c(1.2*min(signed.ctrJ), 1.2*max(signed.ctrJ))
) + ggtitle("", subtitle = 'columns component 3')
grid.arrange(
as.grob(ctrJ.1),as.grob(ctrJ.2),as.grob(ctrJ.3),
ncol = 1,nrow = 3,
top = textGrob("Contributions", gp = gpar(fontsize = 18, font = 3))
)
Ctr.IJ <- recordPlot() # you need this line to be able to save them in the end
BR.J <- resMCA.inf$Inference.Data$fj.boots$tests$boot.ratios
laDim = 1
# Plot the bootstrap ratios for Dimension 1
ba002.BR1.J <- PrettyBarPlot2(BR.J[,laDim],
threshold = 2,
font.size = 3,
color4bar = gplots::col2hex(resMCA.inf$Fixed.Data$Plotting.Data$fj.col), # we need hex code
ylab = 'Bootstrap ratios'
#ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle("", subtitle = 'columns Dimension 1')
# Plot the bootstrap ratios for Dimension 2
laDim = 2
ba004.BR2.J <- PrettyBarPlot2(BR.J[,laDim],
threshold = 2,
font.size = 3,
color4bar = gplots::col2hex(resMCA.inf$Fixed.Data$Plotting.Data$fj.col), # we need hex code
ylab = 'Bootstrap ratios'
#ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle("", subtitle = 'columns Dimension 2')
# Plot the bootstrap ratios for Dimension 3
laDim = 3
ba004.BR3.J <- PrettyBarPlot2(BR.J[,laDim],
threshold = 2,
font.size = 3,
color4bar = gplots::col2hex(resMCA.inf$Fixed.Data$Plotting.Data$fj.col), # we need hex code
ylab = 'Bootstrap ratios'
#ylim = c(1.2*min(BR[,laDim]), 1.2*max(BR[,laDim]))
) + ggtitle("", subtitle = 'columns Dimension 3')
grid.arrange(
as.grob(ba002.BR1.J),as.grob(ba004.BR2.J),as.grob(ba004.BR3.J),
ncol = 1,nrow = 3,
top = textGrob("Bootstrap ratios", gp = gpar(fontsize = 18, font = 3))
)
BR.IJ <- recordPlot() # you need this line to be able to save them in the end
The following chunk can give you a .pptx file with all your figures saved in the directory.
REMEMBER: Never use a screen shot
# Here we can save all figures to a PowerPoint
savedList <- saveGraph2pptx(file2Save.pptx = 'AllFigures_MCA',
title = 'All Figures for MCA',
addGraphNames = TRUE)
## Warning: File: AllFigures_MCA.pptx already exists.
## Oldfile has been renamed: AllFigures_MCA-2019-10-13.pptx
When we interpret the factor scores and loadings together, the MCA revealed:
Component 1
Rows: Severity of depression group.
Cols: Severity of score.
Interpret: The more depressed the higher the score.
Component 2
Rows: Minimal and Mild depression vs moderately severe and severe.
Cols: Middle scores vs low and high scores.
Interpret: Mininmal and mild depression tend to have scores more in the middle as opposed to moderately severe and severe groups having more polarized scores.
Component 3
Rows: Moderately severe vs severe.
Columns: Moderate disturbances in speed vs high disturbances in speed.
Interpret: People with moderately severe and severe depression severity have moderate to high speed disturbances i.e. both groups experience feeling lethargic or extremely energtic.